home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / i386 / i386mcode.sml < prev   
Encoding:
Text File  |  1993-01-27  |  11.6 KB  |  356 lines
  1. (* i386mcode.sml
  2.  * by Yngvi Guttesen (ysg@id.dth.dk) and Mark Leone (mleone@cs.cmu.edu)
  3.  *
  4.  * Copyright 1989 by      Department of Computer Science, 
  5.  *              The Technical University of Denmak
  6.  *              DK-2800 Lyngby 
  7.  *)
  8.  
  9. functor I386MCode (Jumps : I386JUMPS) : I386CODER = struct
  10.  
  11. structure Emitter : BACKPATCH = Backpatch(Jumps)
  12. open Emitter Jumps
  13.  
  14. val emitbyte = fn i => emitstring(ebyte i)
  15. val emitlong = fn i => emitstring(elong i)
  16. fun realconst s = emitstring(implode(rev(explode(IEEEReal.realconst s))))
  17.  
  18. datatype EA = Direct of int
  19.         | Displace of int * int
  20.         | Index of int * int * int * Size
  21.         | Immed of int
  22.         | Immedlab of Label
  23.         | Floatreg of int
  24.  
  25. (*************************** The 80386 registers ******************************)
  26.  
  27. val eax = 0
  28. and ebx = 3
  29. and ecx = 1
  30. and edx = 2
  31. and esi = 6
  32. and edi = 7
  33. and ebp = 5
  34. and esp = 4
  35.  
  36. (*********************** Emit the addr. and data extension *******************)
  37.  
  38. fun die s = ErrorMsg.impossible ("i386/i386mcode.sml: " ^ s)
  39.  
  40. (* Emit the Scaled/Index/Base byte *)
  41. fun emitsib(Index(base, _, index, size)) =
  42.     let val ss = if index=4 then 0
  43.              else (case size of Byte => 0 | Word => 1 | Long => 2)
  44.     in  ebyte(ss*64 + index*8 + base) end
  45.   | emitsib _ = die "emitsib: bad args"
  46.  
  47. (* Emit the mod-reg-r/m byte and addr. and data 
  48.  * extension for binary operations 
  49.  *)
  50. fun emitext(Direct s, Direct d) = ebyte(3*64 + 8*d + s)
  51.   | emitext(Displace(s, 0), b as Direct d) =
  52.     if s=esp
  53.     then emitext(Index(s,0,4,Byte), b)
  54.     else    if s=ebp 
  55.         then (ebyte(1*64 + d*8 + ebp) ^ ebyte(0))
  56.         else  ebyte(d*8 + s)
  57.   | emitext(Displace(s,i), b as Direct d) =
  58.     if s=esp
  59.     then emitext(Index(s,i,4,Byte), b)
  60.     else    if sizeint(i)=Byte
  61.         then (ebyte(1*64 + d*8 + s) ^ ebyte(i))
  62.         else (ebyte(2*64 + d*8 + s) ^ elong(i))
  63.   | emitext(src as Index(s, 0,_,_), Direct d) =
  64.     if s=ebp
  65.     then (ebyte(1*64 + 8*d + 4) ^ emitsib(src) ^ ebyte(0))
  66.     else (ebyte(8*d + 4) ^ emitsib(src))
  67.   | emitext(src as Index(_,i,_,_), Direct d) =
  68.     if sizeint(i)=Byte
  69.     then (ebyte(1*64 + d*8 + 4) ^ emitsib(src) ^ ebyte(i))
  70.     else (ebyte(2*64 + d*8 + 4) ^ emitsib(src) ^ elong(i))
  71.   | emitext(a as Direct _, b as Displace _) = emitext(b,a)
  72.   | emitext(a as Direct _, b as Index _) = emitext(b,a)
  73.   | emitext _ = die "emitext: bad args"
  74.  
  75. fun emitimm i = if sizeint(i)=Byte then ebyte(i) else elong(i)
  76.  
  77. (* Emit the mod-reg-r/m byte and addr. and data     extension for 
  78.  * immediate operations. This is also used in unary operations
  79.  *)
  80. fun emitImmext(opcode, Direct r) = ebyte(3*64 + opcode*8 +r)
  81.   | emitImmext(opcode, Displace(r, 0)) =
  82.     if r=esp 
  83.     then emitImmext(opcode, Index(r,0,4,Byte))
  84.     else    if r=ebp
  85.         then (ebyte(1*64 + opcode*8 + 5) ^ ebyte(0))
  86.         else ebyte(opcode*8 + r)
  87.   | emitImmext(opcode, Displace(r, j)) =
  88.     if r=esp
  89.     then emitImmext(opcode, Index(r,j,4,Byte))
  90.     else    let val mode = (if (sizeint(j) = Byte) then 1 else 2)
  91.         in
  92.             (ebyte(mode*64 + opcode*8 + r) ^ emitimm(j))
  93.         end
  94.   | emitImmext(opcode, dest as Index(r, 0, _, _)) =
  95.     if r=ebp
  96.     then (ebyte(1*64 + opcode*8 + 4) ^ emitsib(dest) ^ ebyte(0))
  97.     else (ebyte(opcode*8 + 4) ^ emitsib(dest))
  98.   | emitImmext(opcode, dest as Index(b, j, _, _)) =
  99.     let val mode = (if (sizeint(j) = Byte) then 1 else 2)
  100.     in (ebyte(mode*64 + opcode*8 + 4) ^ emitsib(dest) ^ emitimm(j))
  101.     end
  102.   | emitImmext _ = die "emitImmext: bad args"
  103.  
  104. (* Generate code for binary operations *)
  105. (******
  106. fun gen2(frst,nxt, src, dest) =
  107.     (case (src,dest) of
  108.         (Immed i, _)  =>  if ~128<=i andalso i<128
  109.                   then (ebyte(131) ^
  110.                     emitImmext(nxt,dest) ^
  111.                     ebyte(i))
  112.                   else (ebyte(129) ^
  113.                     emitImmext(nxt,dest) ^
  114.                     elong(i))
  115.       | (_, Direct _) => (ebyte(frst+3) ^ emitext(src, dest))
  116.       | (Direct _, _) => (ebyte(frst+1) ^ emitext(src, dest))
  117.       | _ => die "gen2: bad args")
  118. ******)
  119.  
  120. fun gen2(frst,nxt, src, dest) =
  121.     (case (src,dest) of
  122.         (Immed i, _)  =>  
  123.         if sizeint(i) = Byte
  124.             then (ebyte(131) ^ emitImmext(nxt,dest) ^ ebyte(i))
  125.         else if dest = Direct 0
  126.             then ebyte (8 * nxt + 5) ^ elong i
  127.         else ebyte(129) ^ emitImmext(nxt,dest) ^ elong(i)
  128.       | (_, Direct _) => (ebyte(frst+3) ^ emitext(src, dest))
  129.       | (Direct _, _) => (ebyte(frst+1) ^ emitext(src, dest))
  130.       | _ => die "gen2: bad args")
  131.  
  132. fun incl(x as Direct d)      = emitstring(ebyte(64+d))
  133.   | incl(x as Displace _) = emitstring(ebyte(255) ^ emitImmext(0,x))
  134.   | incl(x as Index _)      = emitstring(ebyte(255) ^ emitImmext(0,x))
  135.   | incl _ = die "incl: bad args"
  136.  
  137. fun decl(x as Direct d)      = emitstring(ebyte(72+d))
  138.   | decl(x as Displace _) = emitstring(ebyte(255) ^ emitImmext(1,x))
  139.   | decl(x as Index _)      = emitstring(ebyte(255) ^ emitImmext(1,x))
  140.   | decl _ = die "decl: bad args"
  141.  
  142. fun addl(Immed 1, dest) = incl(dest)
  143.   | addl(src, dest)    = emitstring(gen2(  0, 0, src, dest))
  144.  
  145. fun subl(Immed 1, dest) = decl(dest)
  146.   | subl(src, dest)    = emitstring(gen2( 40, 5, src, dest))
  147.  
  148. fun orl (src, dest) = emitstring(gen2(    8, 1, src, dest))
  149. fun xorl(src, dest) = emitstring(gen2( 48, 6, src, dest))
  150. fun andl(src, dest) = emitstring(gen2( 32, 4, src, dest))
  151. fun cmpl(src, dest) = emitstring(gen2( 56, 7, src, dest))
  152.  
  153. fun xchg(Direct 0, Direct r) = emitstring(ebyte(144+r))
  154.   | xchg(Direct r, Direct 0) = emitstring(ebyte(144+r))
  155.   | xchg(x, y) = emitstring(ebyte(135) ^ emitext(x,y))
  156.  
  157. fun notl(x as Direct _) = emitstring(ebyte(247) ^ emitImmext(2,x))
  158.   | notl(x as Displace _) = emitstring(ebyte(247) ^ emitImmext(2,x))
  159.   | notl _ = die "notl: bad args"
  160.  
  161. fun negl(x as Direct _) = emitstring(ebyte(247) ^ emitImmext(3,x))
  162.   | negl(x as Displace _) = emitstring(ebyte(247) ^ emitImmext(3,x))
  163.   | negl _ = die "negl: bad args"
  164.  
  165. fun movl(Immed i, Direct r) = 
  166.     emitstring(ebyte(184+r) ^ elong(i))
  167.   | movl(Immed i, dest) = 
  168.     emitstring(ebyte(199) ^ emitImmext(0,dest) ^ elong(i))
  169.   | movl(src, dest) = emitstring(gen2(136, 0, src, dest))
  170.  
  171. fun movb(Immed i, y) = 
  172.        if sizeint i <> Byte 
  173.        then die "movb: immediate value is not byte-sized"
  174.        else emitstring (ebyte 198 ^ emitImmext(0, y) ^ ebyte i)
  175.   | movb(x, y as Direct y')  = if y' > 3 then die "movb: bad register"
  176.                    else emitstring(ebyte(138) ^ emitext(x,y))
  177.   | movb(x as Direct x', y) = if x' > 3 then die "movb: bad register"
  178.                   else emitstring(ebyte(136) ^ emitext(x,y))
  179.   | movb _ = die "movb: bad args"
  180.  
  181. fun movzx(x, y as Direct _) = emitstring(ebyte(15) ^ ebyte(182) ^ emitext(x,y))
  182.   | movzx _ = die "movzx: bad args"
  183.  
  184. fun stos(Direct 0) = emitstring(ebyte(171))
  185.   | stos _ = die "stos: bad args"
  186.  
  187. fun push(Direct d) = emitstring(ebyte(80 + d))
  188.   | push _ = die "push: bad args"
  189.  
  190. fun pop(Direct d) = emitstring(ebyte(88 + d)) 
  191.   | pop _ = die "pop: bad args"
  192.  
  193. fun shift(_,Immed 0, _) = ()
  194.   | shift(TTT, Immed 1, dest) = 
  195.     emitstring(ebyte(209) ^ emitImmext(TTT,dest))
  196.   | shift(TTT, cnt as Immed i, dest) = 
  197.     emitstring(ebyte(193) ^ emitImmext(TTT,dest) ^ ebyte(i))
  198.   | shift(TTT, cnt as Direct 1, dest) = 
  199.     emitstring(ebyte(211) ^ emitImmext(TTT,dest))
  200.   | shift _ = die "shift: bad args"
  201.  
  202. fun asll(cnt, dest) = shift(4, cnt, dest)
  203. fun asrl(cnt, dest) = shift(7, cnt, dest)
  204.  
  205. (****
  206. fun lea(Displace(s, 0),Direct r) =
  207.     emitstring(ebyte(139) ^ ebyte(3*64 + 8*r + s))
  208.   | lea(Displace(s, i),Direct r) = emitstring(
  209.     ebyte(141) ^
  210.     (case sizeint(i) of
  211.         Byte => (ebyte(1*64 + 8*r + s) ^ ebyte(i))
  212.       | _     => (ebyte(2*64 + 8*r + s) ^ elong(i))))
  213.   | lea(Immedlab l, Direct r) = jump(LEA(r), l)
  214.   | lea _ = die "lea: bad args"
  215. ****)
  216.  
  217. fun lea(Displace(s, 0), Direct d) = movl (Direct s, Direct d)
  218.   | lea(s as Displace _, d as Direct _) = emitstring(ebyte(141) ^ emitext(s,d))
  219.   | lea(s as Index _, d as Direct _) = emitstring(ebyte(141) ^ emitext(s,d))
  220.   | lea(Immedlab l, Direct d) = jump(LEA(d), l)
  221.   | lea _ = die "lea: bad args"
  222.  
  223. fun btst(src as Immed i, dst as Direct _) = emitstring(
  224.     ebyte(15) ^
  225.     ebyte(186) ^ 
  226.     emitImmext(4,dst) ^
  227.     ebyte(i) )
  228.   | btst(src as Immed i, dst as Displace _) = emitstring(
  229.     ebyte(15) ^
  230.     ebyte(186) ^
  231.     emitImmext(4,dst) ^
  232.     ebyte(i) )
  233.   | btst _ = die "btst: bad args"
  234.  
  235. fun emitlab(i,lab) = jump(LABPTR(i), lab)
  236.  
  237. local fun jcc i (Immedlab lab) = jump (Jcc i, lab)
  238.     | jcc _ _ = die "jcc: bad args"
  239. in
  240.     val jne = jcc 5
  241.     val jeq = jcc 4
  242.     val jgt = jcc 15
  243.     val jge = jcc 13
  244.     val jlt = jcc 12
  245.     val jle = jcc 14
  246.     val jb  = jcc 2
  247.     val jbe = jcc 6
  248.     val ja  = jcc 7
  249.     val jae = jcc 3
  250.     val jc  = jcc 2
  251.     val jnc = jcc 3
  252. end
  253.  
  254. fun jra(arg as Immedlab lab) = jump(JMP, lab)
  255.   | jra _ = die "jra: bad args"
  256.  
  257. fun jmp(x as Displace _) = emitstring(ebyte(255) ^ emitImmext(4,x))
  258.   | jmp(x as Direct _)     = emitstring(ebyte(255) ^ emitImmext(4,x))
  259.   | jmp _ = die "jmp: bad args"
  260.  
  261. (****
  262. fun mull(x as Direct _, y as Direct _) = emitstring(
  263.     ebyte(15) ^
  264.     ebyte(175) ^
  265.     emitext(x,y))
  266.   | mull _ = die "mull: bad args"
  267. ****)
  268.  
  269. fun mull(Immed i, Direct r) =
  270.        if sizeint(i) = Byte 
  271.        then emitstring(ebyte(107) ^ ebyte(3*64 + 8*r + r) ^ ebyte(i))
  272.        else
  273.        emitstring(ebyte(105) ^ ebyte(3*64 + 8*r + r) ^ elong(i))
  274.   | mull(src, dest as Direct _) = 
  275.        emitstring(ebyte(15) ^ ebyte(175) ^ emitext(src,dest))
  276.   | mull _ = die "mull: bad args"
  277.  
  278. fun divl(x as Direct r) =  emitstring(ebyte(247) ^ emitImmext(7,x)) 
  279.   | divl(x as Displace _) = emitstring(ebyte(247) ^ emitImmext(7,x))
  280.   | divl _ = die "divl: bad args"
  281.  
  282. fun cdq() = emitstring(ebyte(153))
  283.  
  284. (******************** Floating point operations *******************)
  285.  
  286. (* Instead of using separate functions for those operations that pop
  287.    the 80387 stack (e.g. faddp, fstp, etc.), these functions take a
  288.    boolean argument that specifies whether to pop. *)
  289.  
  290. (* floatarith() emits an arithmetic floating point instruction (e.g.,
  291.    fadd, fmul, etc.)  The operation is encoded in the REG field of the
  292.    MOD/RM byte, which is generated by emitext().  These instructions
  293.    are binary, but one of the arguments must be the top of the
  294.    register stack.  If the destination is the the top of the stack, the
  295.    instruction cannot pop. *)
  296.  
  297. fun float_arith opr true (Floatreg 0, Floatreg r) = 
  298.        emitstring (ebyte 0xde ^ emitext (Direct r, Direct opr))
  299.   | float_arith opr false (Floatreg 0, Floatreg r) = 
  300.        emitstring (ebyte 0xdc ^ emitext (Direct r, Direct opr))
  301.   | float_arith opr false (Floatreg r, Floatreg 0) =
  302.        emitstring (ebyte 0xd8 ^ emitext (Direct r, Direct opr))
  303.   | float_arith opr false (src as Displace _, Floatreg 0) =
  304.        emitstring (ebyte 0xdc ^ emitext (src, Direct opr))
  305.   | float_arith _ _ _ = die "float_arith: bad args"
  306.  
  307. val fadd  = float_arith 0
  308. val fmul  = float_arith 1
  309. val fcom  = fn pop => if pop then float_arith 3 false
  310.               else float_arith 2 false
  311. val fsub  = float_arith 4
  312. val fsubr = float_arith 5
  313. val fdiv  = float_arith 6
  314. val fdivr = float_arith 7
  315.  
  316. fun fchs ()  = emitstring (ebyte 0xd9 ^ ebyte 0xe0)
  317. fun fabs ()  = emitstring (ebyte 0xd9 ^ ebyte 0xe1)
  318. fun fstsw () = emitstring (ebyte 0xdf ^ ebyte 0xe0)
  319.  
  320. fun fld (Floatreg r) = 
  321.        emitstring (ebyte 0xd9 ^ emitext (Direct r, Direct 0))
  322.   | fld (src as Displace _) = 
  323.        emitstring (ebyte 0xdd ^ emitext (src, Direct 0))
  324.   | fld (src as Index _) = 
  325.        emitstring (ebyte 0xdd ^ emitext (src, Direct 0))
  326.   | fld _ = die "fld: bad args"
  327.  
  328. fun fild (src as Displace _) = 
  329.        emitstring (ebyte 0xdb ^ emitext (src, Direct 0))
  330.   | fild (src as Index _) = 
  331.        emitstring (ebyte 0xdb ^ emitext (src, Direct 0))
  332.   | fild _ = die "fild: bad args"
  333.  
  334. fun fst pop dst =
  335.     let val opr = if pop then 3 else 2
  336.     in
  337.     emitstring (ebyte 0xdd);
  338.     case dst
  339.       of Floatreg r => emitstring (emitext (Direct r, Direct opr))
  340.        | Displace _ => emitstring (emitext (dst, Direct opr))
  341.        | Index _ => emitstring (emitext (dst, Direct opr))
  342.        | _ => die "fst: bad args"
  343.     end
  344.  
  345. (********************* Misc. Functions *********************)
  346.  
  347. fun sahf() = emitstring(ebyte(158))
  348.  
  349. fun into () = emitstring(ebyte(206))
  350.  
  351. fun comment _ = ()
  352.  
  353. val finish = Emitter.finish
  354.  
  355. end (* functor I386MCode *)
  356.